Attribute VB_Name = "modSort"
Option Explicit

Private Const ZERO = 0
Private Const ASCENDING_ORDER = 0
Private Const DESCENDING_ORDER = 1

Sub BubbleSort(MyArray(), ByVal nOrder As Integer)
    Dim Index
    Dim TEMP
    Dim NextElement

    NextElement = ZERO
    Do While (NextElement < UBound(MyArray))
        Index = UBound(MyArray)
        Do While (Index > NextElement)
            If nOrder = ASCENDING_ORDER Then
                If MyArray(Index) < MyArray(Index - 1) Then
                    TEMP = MyArray(Index)
                    MyArray(Index) = MyArray(Index - 1)
                    MyArray(Index - 1) = TEMP
                End If
            ElseIf nOrder = DESCENDING_ORDER Then
                If MyArray(Index) >= MyArray(Index - 1) Then
                    TEMP = MyArray(Index)
                    MyArray(Index) = MyArray(Index - 1)
                    MyArray(Index - 1) = TEMP
                End If
            End If
            Index = Index - 1
        Loop
        NextElement = NextElement + 1
    Loop

End Sub

Sub Bucket(MyArray(), ByVal nOrder As Integer)
    Dim Index
    Dim NextElement
    Dim TheBucket

    NextElement = LBound(MyArray) + 1
    While (NextElement <= UBound(MyArray))
        TheBucket = MyArray(NextElement)
        Index = NextElement
        Do
            If Index > LBound(MyArray) Then
                If nOrder = ASCENDING_ORDER Then
                    If TheBucket < MyArray(Index - 1) Then
                        MyArray(Index) = MyArray(Index - 1)
                        Index = Index - 1
                    Else
                        Exit Do
                    End If
                ElseIf nOrder = DESCENDING_ORDER Then
                    If TheBucket >= MyArray(Index - 1) Then
                        MyArray(Index) = MyArray(Index - 1)
                        Index = Index - 1
                    Else
                        Exit Do
                    End If
                End If
            Else
                Exit Do
            End If
        Loop
        MyArray(Index) = TheBucket
        NextElement = NextElement + 1
    Wend

End Sub

Sub Heap(MyArray())
    Dim Index
    Dim Size
    Dim TEMP

    Size = UBound(MyArray)
    
    Index = 1
    While (Index <= Size)
        Call HeapSiftup(MyArray(), Index)
        Index = Index + 1
    Wend

    Index = Size
    While (Index > 0)
        TEMP = MyArray(0)
        MyArray(0) = MyArray(Index)
        MyArray(Index) = TEMP
        Call HeapSiftdown(MyArray(), Index - 1)
        Index = Index - 1
    Wend

End Sub
 

Sub HeapSiftdown(MyArray(), M)
    Dim Index
    Dim Parent
    Dim TEMP

    Index = 0
    Parent = 2 * Index

    Do While (Parent <= M)
        
        If (Parent < M And MyArray(Parent) < MyArray(Parent + 1)) Then
            Parent = Parent + 1
        End If

        If MyArray(Index) >= MyArray(Parent) Then
            Exit Do
        End If

        TEMP = MyArray(Index)
        MyArray(Index) = MyArray(Parent)
        MyArray(Parent) = TEMP
        
        Index = Parent
        Parent = 2 * Index
    Loop
End Sub

Sub HeapSiftup(MyArray(), M)
    Dim Index
    Dim Parent
    Dim TEMP

    Index = M
    Do While (Index > 0)
        Parent = Int(Index / 2)

        If MyArray(Parent) >= MyArray(Index) Then
            Exit Do
        End If
        
        TEMP = MyArray(Index)
        MyArray(Index) = MyArray(Parent)
        MyArray(Parent) = TEMP

        Index = Parent
    Loop
    
End Sub

Sub Insertion(MyArray(), ByVal nOrder As Integer)
    Dim Index
    Dim TEMP
    Dim NextElement
    
    NextElement = LBound(MyArray) + 1
    While (NextElement <= UBound(MyArray))
        Index = NextElement
        Do
            If Index > LBound(MyArray) Then
                If nOrder = ASCENDING_ORDER Then
                    If MyArray(Index) < MyArray(Index - 1) Then
                        TEMP = MyArray(Index)
                        MyArray(Index) = MyArray(Index - 1)
                        MyArray(Index - 1) = TEMP
                        Index = Index - 1
                    Else
                        Exit Do
                    End If
                ElseIf nOrder = DESCENDING_ORDER Then
                    If MyArray(Index) >= MyArray(Index - 1) Then
                        TEMP = MyArray(Index)
                        MyArray(Index) = MyArray(Index - 1)
                        MyArray(Index - 1) = TEMP
                        Index = Index - 1
                    Else
                        Exit Do
                    End If
                End If
            Else
                Exit Do
            End If
        Loop
        NextElement = NextElement + 1
    Wend

End Sub

Sub QuickSort(MyArray(), L, R)
    Dim i, J, X, Y

    i = L
    J = R
    X = MyArray((L + R) / 2)
        
    While (i <= J)
        While (MyArray(i) < X And i < R)
            i = i + 1
        Wend
        While (X < MyArray(J) And J > L)
            J = J - 1
        Wend
        If (i <= J) Then
            Y = MyArray(i)
            MyArray(i) = MyArray(J)
            MyArray(J) = Y
            i = i + 1
            J = J - 1
        End If
    Wend

    If (L < J) Then Call QuickSort(MyArray(), L, J)
    If (i < R) Then Call QuickSort(MyArray(), i, R)
End Sub

Sub Selection(MyArray(), ByVal nOrder As Integer)
    Dim Index
    Dim Min
    Dim NextElement
    Dim TEMP

    NextElement = 0
    While (NextElement < UBound(MyArray))
        Min = UBound(MyArray)
        Index = Min - 1
        While (Index >= NextElement)
            If nOrder = ASCENDING_ORDER Then
                If MyArray(Index) < MyArray(Min) Then
                    Min = Index
                End If
            ElseIf nOrder = DESCENDING_ORDER Then
                If MyArray(Index) >= MyArray(Min) Then
                    Min = Index
                End If
            End If
            Index = Index - 1
        Wend
        TEMP = MyArray(Min)
        MyArray(Min) = MyArray(NextElement)
        MyArray(NextElement) = TEMP
        NextElement = NextElement + 1
    Wend

End Sub

Sub ShellSort(MyArray(), ByVal nOrder As Integer)
    Dim Distance
    Dim Size
    Dim Index
    Dim NextElement
    Dim TEMP

    Size = UBound(MyArray) - LBound(MyArray) + 1
    Distance = 1

    While (Distance <= Size)
        Distance = 2 * Distance
    Wend

    Distance = (Distance / 2) - 1
    
    While (Distance > 0)
    
        NextElement = LBound(MyArray) + Distance
    
        While (NextElement <= UBound(MyArray))
            Index = NextElement
            Do
                If Index >= (LBound(MyArray) + Distance) Then
                    If nOrder = ASCENDING_ORDER Then
                        If MyArray(Index) < MyArray(Index - Distance) Then
                            TEMP = MyArray(Index)
                            MyArray(Index) = MyArray(Index - Distance)
                            MyArray(Index - Distance) = TEMP
                            Index = Index - Distance
                        Else
                            Exit Do
                        End If
                    ElseIf nOrder = DESCENDING_ORDER Then
                        If MyArray(Index) >= MyArray(Index - Distance) Then
                            TEMP = MyArray(Index)
                            MyArray(Index) = MyArray(Index - Distance)
                            MyArray(Index - Distance) = TEMP
                            Index = Index - Distance
                        Else
                            Exit Do
                        End If
                    End If
                Else
                    Exit Do
                End If
            Loop
            NextElement = NextElement + 1
        Wend
        Distance = (Distance - 1) / 2
    Wend
    
End Sub

Public Sub Ascii_Sort(Numbers As Variant, ByRef SortedPtrs() As Long)
    ' a v.quick sort for numbers in the range 0-255
    ' (Written by Steve Smith, Stuff Software Ltd, ss.software@zetnet.co.uk, c.Aug96)
    
    ' RETURNS:
    ' SortedPtrs() = list of pointers to Numbers(), with biggest first.
    
    ' THE PRINCIPLE:
    ' To utilise the Basic/VB INSTR function to subcontract the inner loop of a sort algorithm
    '   out to machine code, rather than have VB plough through it line by line via the interpreter.
    ' It could probably be rewritten for integers or longs, with an MKI/MKL simulator to build SortStr$
    '   & checking that each substring found is on a 2 or 4-byte boundary.
    
    ' NOTES RE. SPEED:
    ' Has the advantage that the speed is proportional to nNumbers,
    '   rather than to nNumbers^2 or nNumber.Ln(nNumbers) - as in most sorting algorithms,
    '   since the INSTR function effectively replaces the inner loop. It also gains in having
    '   no recursive calls.
    ' The lower the biggest number, the faster the sort.
    ' This makes other supposedly 'ultra-fast' sorts look positively snail-like
    '   (eg. with random numbers 0-255, VB4 16-bit on a Pentium 166 -
    '   20,000 numbers - ShellSort 7.3sec, QuickSort 4.7sec, Ascii_Sort 0.32sec !
    '   2,000 numbers - ShellSort 0.45sec, QuickSort 0.34sec, Ascii_Sort 0.05 !)
    
    Dim StartNumber%, EndNumber%, nNumbers%
    Dim SortStr$, Number%, PointerNum%
    Dim Ptr%, i%, Char$
    
    ' misc. preparation
    StartNumber = LBound(Numbers)
    EndNumber = UBound(Numbers)
    nNumbers = EndNumber - StartNumber + 1
    ReDim SortedPtrs(1 To nNumbers)
    
    ' build sortStr$
    '   (this mirrors the Numbers() array, as a string of characters)
    SortStr$ = Space$(nNumbers)
    For i = StartNumber To EndNumber
        Mid$(SortStr$, i - StartNumber + 1, 1) = Chr$(Numbers(i))
    Next
    
    ' sort (starting with the lowest numbers)
    Number = -1
    PointerNum = nNumbers + 1
    Do While PointerNum > 1
        
        ' find next lowest character/number
        Do
            Number = Number + 1
            Ptr = InStr(SortStr$, Chr$(Number))
        Loop Until Ptr
        
        ' return a pointer for each occurences of that character/number
        Char$ = Chr$(Number)
        Do
            PointerNum = PointerNum - 1
            SortedPtrs(PointerNum) = Ptr + StartNumber - 1
            Ptr = InStr(Ptr + 1, SortStr$, Char$)
        Loop Until Ptr = 0
    Loop
End Sub


Sub InsertionX(ByVal nOrder As Integer, IndexArray, ParamArray OtherArrays())
    Dim Index
    Dim TEMP
    Dim NextElement
    Dim i As Long
    
    NextElement = LBound(IndexArray) + 1
    While (NextElement <= UBound(IndexArray))
        Index = NextElement
        Do
            If Index > LBound(IndexArray) Then
                If nOrder = 1 Then
                    If IndexArray(Index) < IndexArray(Index - 1) Then
                        TEMP = IndexArray(Index)
                        IndexArray(Index) = IndexArray(Index - 1)
                        IndexArray(Index - 1) = TEMP
                        For i = 0 To UBound(OtherArrays)
                            TEMP = OtherArrays(i)(Index)
                            OtherArrays(i)(Index) = OtherArrays(i)(Index - 1)
                            OtherArrays(i)(Index - 1) = TEMP
                        Next
                        Index = Index - 1
                    Else
                        Exit Do
                    End If
                ElseIf nOrder = 0 Then
                    If IndexArray(Index) >= IndexArray(Index - 1) Then
                        TEMP = IndexArray(Index)
                        IndexArray(Index) = IndexArray(Index - 1)
                        IndexArray(Index - 1) = TEMP
                        For i = 0 To UBound(OtherArrays)
                            TEMP = OtherArrays(i)(Index)
                            OtherArrays(i)(Index) = OtherArrays(i)(Index - 1)
                            OtherArrays(i)(Index - 1) = TEMP
                        Next
                        Index = Index - 1
                    Else
                        Exit Do
                    End If
                End If
            Else
                Exit Do
            End If
        Loop
        NextElement = NextElement + 1
    Wend
End Sub

